home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / smaltalk.lha / smalltalk-1.1.1 / stix / X.st < prev    next >
Text File  |  1991-09-12  |  5KB  |  250 lines
  1. "======================================================================
  2. |
  3. | Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  4. | Written by Steve Byrne.
  5. |
  6. | This file is part of GNU Smalltalk.
  7. |
  8. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  9. | under the terms of the GNU General Public License as published by the Free
  10. | Software Foundation; either version 1, or (at your option) any later version.
  11. | 
  12. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  13. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  14. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  15. | details.
  16. | 
  17. | You should have received a copy of the GNU General Public License along with
  18. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  19. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  20. |
  21.  ======================================================================"
  22.  
  23.  
  24. "
  25. |     Change Log
  26. | ============================================================================
  27. | Author       Date       Change 
  28. | sbyrne     24 May 90      created.
  29. |
  30. "
  31.  
  32. Object subclass: #X
  33.     instanceVariableNames: 'socket'
  34.     classVariableNames: ''
  35.     poolDictionaries: 'XGlobals'
  36.     category: 'X hacking'
  37. !
  38.  
  39. #(BaseMask BaseId RootWindow RootWindowID BlackPixel WhitePixel VisualId)
  40.     do: [ :var | Smalltalk at: var put: nil ].
  41.  
  42.  
  43.  
  44. Behavior defineCFunc: 'connectToServer'
  45.      withSelectorArgs: 'connectToServer: hostName display: displayNum'
  46.      forClass: X class
  47.      returning: #int
  48.      args: #(string int)
  49. .
  50.  
  51. Behavior defineCFunc: 'waitForSocket'
  52.      withSelectorArgs: 'waitForSocket: socket timeOut: anInteger'
  53.      forClass: X
  54.      returning: #int    "need a boolean type"
  55.      args: #(int int)
  56. .
  57.  
  58. Behavior defineCFunc: 'byte'
  59.      withSelectorArgs: 'byteFrom: socket'
  60.      forClass: X
  61.      returning: #int
  62.      args: #(int)
  63. .
  64.  
  65. Behavior defineCFunc: 'word'
  66.      withSelectorArgs: 'wordFrom: socket'
  67.      forClass: X
  68.      returning: #int
  69.      args: #(int)
  70. .
  71.  
  72. Behavior defineCFunc: 'long'
  73.      withSelectorArgs: 'longFrom: socket'
  74.      forClass: X
  75.      returning: #int
  76.      args: #(int)
  77. .
  78.  
  79. Behavior defineCFunc: 'putByte'
  80.      withSelectorArgs: 'putByteOn: socket byte: aByte'
  81.      forClass: X
  82.      returning: #void
  83.      args: #(int int)
  84. .
  85.  
  86. Behavior defineCFunc: 'putWord'
  87.      withSelectorArgs: 'putWordOn: socket word: aWord'
  88.      forClass: X
  89.      returning: #void
  90.      args: #(int int)
  91. .
  92.  
  93. Behavior defineCFunc: 'putLong'
  94.      withSelectorArgs: 'putLongOn: socket long: aLong'
  95.      forClass: X
  96.      returning: #void
  97.      args: #(int int)
  98. !
  99.  
  100. Behavior defineCFunc: 'putBytes'
  101.      withSelectorArgs: 'putBytesOn: socket numBytes: n bytes: byteArray'
  102.      forClass: X
  103.      returning: #void
  104.      args: #(int int byteArray)
  105. !
  106.  
  107.  
  108. !X class methodsFor: 'instance creation'!
  109.  
  110. connectTo: server display: displayNum
  111.     | x |
  112.     x _ self new.
  113.     x init: (self connectToServer: server display: displayNum).
  114.     ^x
  115. !!
  116.     
  117.  
  118. !X methodsFor: 'low level protocol stream interface'!
  119.  
  120. byte
  121.     ^self byteFrom: socket
  122. !
  123.  
  124. ubyte
  125.     ^(self byteFrom: socket) bitAnd: 16rFF
  126. !
  127.  
  128. word
  129.     ^self wordFrom: socket
  130. !
  131.  
  132. uword
  133.     ^(self wordFrom: socket) bitAnd: 16rFFFF
  134. !
  135.  
  136. long
  137.     ^self longFrom: socket
  138. !
  139.  
  140. ulong
  141.     ^self longFrom: socket    "what if it's negative????"
  142. !
  143.  
  144. getString: len
  145.     | str pad |
  146.     str _ String new: len.
  147.     pad _ (4 - len) bitAnd: 3.
  148.  
  149.     1 to: len do: 
  150.     [ :i | str at: i put: (Character value: self byte) ].
  151.     pad timesRepeat: [ self byte ]. "pad to 4 byte boundary"
  152.     ^str
  153. !
  154.  
  155. getUnpaddedString: len
  156.     | str |
  157.     str _ String new: len.
  158.     1 to: len do: 
  159.     [ :i | str at: i put: (Character value: self byte) ].
  160.     ^str
  161. !
  162.  
  163. mappedId
  164.     | id |
  165.     id _ self long.
  166.     ^Registry at: id
  167.           ifAbsent: [ nil ]
  168. !
  169.  
  170. maybeMappedId: symbolArray
  171.     | id |
  172.     id _ self long.
  173.     id < symbolArray size
  174.     ifTrue: [ ^symbolArray at: id + 1 ]
  175.     ifFalse: [ ^Registry at: id
  176.                ifAbsent: [ nil ] ]
  177. !
  178.  
  179. skipBytes: len
  180.     | pad |
  181.     len timesRepeat: [ self byte ] "not terribly optimal"
  182. !
  183.  
  184. byte: aByte
  185.     self putByteOn: socket byte: aByte
  186. !
  187.  
  188. char: aChar
  189.     self putByteOn: socket byte: aChar asciiValue
  190. !
  191.  
  192. word: aWord
  193.     self putWordOn: socket word: aWord
  194. !
  195.  
  196. long: aLong
  197.     self putLongOn: socket long: aLong
  198. !
  199.  
  200. bytes: byteArray
  201.     self putBytesOn: socket numBytes: byteArray basicSize bytes: byteArray
  202. !
  203.  
  204. putString: aString
  205.     aString do: [ :char | self byte: char asciiValue ]
  206. !
  207.  
  208. padBytes: len
  209.     ((4 - len) bitAnd: 3) timesRepeat: [ self byte: 0 ]
  210. !
  211.  
  212. wait: anInteger            "maybe a Delay at some point?, or a Time"
  213.     ^(self waitForSocket: socket timeOut: anInteger) = 1
  214. !!
  215.  
  216.  
  217. !X class methodsFor: 'foo'!    "this shouldn't be X class"
  218.  
  219. map: aSymbol into: anArray
  220.     ^(anArray indexOf: aSymbol 
  221.           ifAbsent: [ ^self error: 'Can''t map ', 
  222.                   aSymbol printString, ' into', 
  223.                   anArray printString])
  224.     - 1
  225. !
  226.  
  227. maybeMap: aSymbol into: anArray
  228.     ^(anArray indexOf: aSymbol 
  229.           ifAbsent: [ ^aSymbol id ])
  230.     - 1
  231. !
  232.  
  233. declareBitNames: bitArray inDictionary: aDict
  234.     | bit |
  235.     bit _ 1.
  236.     bitArray do:
  237.     [ :sym | sym notNil
  238.              ifTrue: [ aDict at: sym put: bit ].
  239.          bit _ bit bitShift: 1 ]
  240. !!
  241.  
  242.  
  243.  
  244. !X methodsFor: 'private'!
  245.  
  246. init: socketFD
  247.     socket _ socketFD
  248. !!
  249.  
  250.